home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 May / CHIP Mayıs 1997.iso / cont / sharew / xpak / xpak041.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-30  |  34.8 KB  |  1,065 lines
  1. program xPak; (* .PAK file manipulator *)
  2.  
  3. {$M 16384,102400,655360}   {Enough heap to load PAK0.PAK directory min}
  4.  
  5. uses wildmat,dos,crt;
  6.  
  7. const
  8.      LUMP_NAME_SIZE      = $40-8;
  9.      END_CHARS           = [#10,#0,#32,#13];
  10.      PAK_HEADER          = 'PACK';
  11.      PAK_PROTECTED       = 'PAK0.PAK';
  12.      MAX_BLOCK_SIZE:word = 65528;
  13.  
  14.      {HALT codes, not fully implemented yet}
  15.      HALT_PARSE          = 1;
  16.      HALT_SAFETY         = 3;
  17.      HALT_QUIT           = 4;
  18.  
  19. type
  20.     Buffer= array[1..65528] of byte;
  21.     LumpNameType= array[1..LUMP_NAME_SIZE] of char;
  22.     Modes=(None,List,Extract,Add,Remove,Rename,Merge);
  23.  
  24.     DirEntry=record
  25.       Lumpname : LumpNameType;
  26.       Pos      : Longint;
  27.       Size     : LongInt;
  28.     end;
  29.  
  30.     PFileSpecList=^TFileSpecList;
  31.     TFileSpecList=record
  32.       FileSpec : string[140];
  33.       LumpName : string[LUMP_NAME_SIZE];
  34.       Remapped : boolean;
  35.       included : boolean;
  36.       Next     : PFileSpecList;
  37.     end;
  38.  
  39.     PMasterDir=^TMasterDir;
  40.     TMasterDir=record         {212 bytes}
  41.       Dir      : DirEntry;
  42.       Filename : string[140];
  43.       Prev     : PMasterDir;
  44.       Next     : PMasterDir;
  45.     end;
  46.  
  47.     TFlags=record
  48.       Override : boolean;
  49.       Verbose  : boolean;
  50.       Force    : boolean;
  51.       Interact : boolean;
  52.       Query    : boolean;
  53.       AccessPAK: boolean;
  54.       Backup   : boolean;
  55.       JustName : boolean;
  56.       Debug    : boolean;
  57.     end;
  58.  
  59.  
  60. var
  61.    Flags: TFlags;
  62. {   o: text;}
  63.  
  64.  
  65. procedure Help;
  66.   begin
  67.        Writeln('usage: xpak <pakfile> -l|-e|-a|-r|-n [lumpname:]filespec [switches]');
  68.        Writeln;
  69.        Writeln('Command line must contain *one* of the following switches:');
  70.        writeln('           (r) = read; (c) = create; (m) = modify');
  71.        writeln('    -l (r) List contents of PAK file');
  72.        writeln('    -e (r) Extract specified files to directory tree');
  73.        writeln('    -a (c) Add specified files to PAK file (also create and update files)');
  74.        writeln('    -r (m) Remove specified lumps');
  75.        writeln('    -n (m) Rename lump in PAK file (renames to :filename');
  76.        writeln('Notice: -u and old -c have been removed.  They have been integrated into -a');
  77.        writeln(#13#10,'Press any key for next page');ReadKey;
  78.        writeln(#13#10,'Modification switches:');
  79.        writeln('    -o     Overrides some of the safety features in xpak.  These include');
  80.        writeln('           not writing to ID1.PAK and requiring existance of ./quake.exe');
  81.        writeln('    -j     (with -l) display just names only (useful to create @file lists)');
  82.        writeln('    -v     verbose mode.  Display names of lumps during processing.');
  83.        writeln('    -d     debug mode.  Displays all sorts of useless debugging info.');
  84.        writeln('    -i     (with -e) Interactive mode.  Prompt to overwrite files');
  85.        writeln('    -f     (with -e) Force overwrites.  Default is to skip existing files');
  86.        writeln(' #  -q     Query mode, ask before adding/extracting/removing each file');
  87.        writeln(' #  -b     backup PAK file before modification / existing extract targets');
  88.        writeln;
  89.        writeln('Lump names may be specified as free * and ? wildcards, but filenames');
  90.        writeln('(excludes -e) require DOS style paths and wildcards.  To access a lump name');
  91.        writeln('with a different filename, use the syntax lumpname:filename.  Wildcards not');
  92.        writeln('allowed.  File lists can be referenced as @filename. # denotes comment line');
  93.        writeln;
  94.        writeln('Remember that this is an early version, and may have ''problems'' =) Note also');
  95.        writeln('that xpak is now more-or-less unsupported, as I am working on a rewrite, sixpak');
  96.        halt;
  97.   end;
  98.  
  99.  
  100. procedure Lower4(var Str: String);
  101.   InLine(          {Adapted From SWAG}
  102.     $8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('A')/Ord('Z')/
  103.     $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$44/$FF/$20/$E2/$F1/$8E/$DA);
  104.  
  105.  
  106. procedure cvBackSlash(var ForeStr: string);
  107.   var i: byte;
  108.   begin
  109.        for i:=1 to Length(ForeStr) do
  110.            if ForeStr[i]='/' then ForeStr[i]:='\';
  111.   end;
  112.  
  113.  
  114. procedure cvForeSlash(var BackStr: string);
  115.   var i: byte;
  116.   begin
  117.        for i:=1 to Length(BackStr) do
  118.            if BackStr[i]='\' then BackStr[i]:='/';
  119.   end;
  120.  
  121.  
  122. procedure SetStr(var st:string; const ar:LumpNameType);
  123.   var
  124.      i: byte;
  125.   begin
  126.        st:='';
  127.        for i:=1 to LUMP_NAME_SIZE do
  128.            begin
  129.            if ar[i] in END_CHARS then begin dec(i); break end;
  130.            st[i]:=ar[i];
  131.            end;
  132.        st[0]:=Char(i);
  133.   end;
  134.  
  135.  
  136. procedure SetArr(var ar: LumpNameType; const st:string);
  137.   var
  138.      i,j: byte;
  139.   begin
  140.        FillChar(ar,SizeOf(ar),0);
  141.        j:=Length(st);
  142.        if Length(st)>LUMP_NAME_SIZE then j:=LUMP_NAME_SIZE;
  143.        for i:=1 to j do
  144.            ar[i]:=st[i];
  145.   end;
  146.  
  147.  
  148. function Exist(const filename:string): boolean;
  149.   var
  150.      DirInfo:SearchRec;
  151.   begin
  152.        FindFirst(filename,Anyfile,DirInfo);
  153.         Exist:=(DosError=0);
  154.   end;
  155.  
  156.  
  157. function MakePAKFilename(const oldname:string):string;
  158.   begin
  159.        if Pos('.',oldname)>0 then
  160.           MakePAKFilename:=oldname
  161.        else
  162.            MakePAKFilename:=oldname+'.pak';
  163.   end;
  164.  
  165.  
  166. procedure AddFileSpec(fs:string; yn: boolean; var TempPos: PFileSpecList);
  167.   var
  168.      spec,lump:string;
  169.      cpos: byte;
  170.      remap:boolean;
  171.   begin
  172.        lump:=fs;spec:=fs;
  173.        cpos:=pos(':',fs);
  174.        remap:=false;
  175.        if cpos>0 then
  176.           begin
  177.           if pos('*',fs)>0 then
  178.              begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
  179.           if pos('?',fs)>0 then
  180.              begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
  181.           lump:=Copy(fs,1,cpos-1);
  182.           spec:=Copy(fs,cpos+1,255);
  183.           remap:=true;
  184.           end;
  185.        New(TempPos^.Next);
  186.        TempPos:=TempPos^.Next;
  187.        cvBackslash(spec);
  188.        cvForeslash(lump);
  189.        Lower4(lump);
  190.        TempPos^.Filespec:=spec;
  191.        TempPos^.Lumpname:=lump;
  192.        TempPos^.Included:=yn;
  193.        TempPos^.Remapped:=remap;
  194.        TempPos^.Next:=nil;
  195.   end;
  196.  
  197.  
  198. procedure FromFile(fn:string;Incl: boolean; var ListTemp: PFileSpecList);
  199.   var
  200.      ff: text;
  201.      fs: string;
  202.   begin
  203.        if fn[1]='@' then Delete(fn,1,1);
  204.        Assign(ff,fn);
  205.        {$I-}
  206.        Reset(ff);
  207.        if IOResult<>0 then
  208.           begin writeln('parse: unable to open filespec list file.'); exit end;
  209.        {$I+}
  210.        while not eof(ff) do
  211.              begin
  212.              ReadLn(ff,fs);
  213.              if fs<>'' then
  214.                 if fs[1]<>'#' then
  215.                    if fs[1]='!' then
  216.                       AddFileSpec(Copy(fs,2,Length(fs)-1),not incl,ListTemp)
  217.                    else
  218.                        AddFileSpec(fs,incl,ListTemp);
  219.              end;
  220.   end;
  221.  
  222.  
  223. function CheckParams(var MainPAK:string; var Files: PFileSpecList):Modes;
  224.   var
  225.      Param:string;
  226.      i:byte;
  227.      TempSpec:PFileSpecList;
  228.      SpecStart: PFileSpecList;
  229.      TempMode: Modes;
  230.      Include: boolean;
  231.   begin
  232.        TempMode:=None;Include:=True;MainPAK:='';
  233.        FillChar(Flags,SizeOf(Flags),0);
  234.        New(Files); TempSpec:=Files;
  235.        TempSpec^.Filespec:='*';
  236.        TempSpec^.Included:=True;
  237.        TempSpec^.Next:=nil;
  238.        if ParamCount=0 then begin writeln('Type `xpak -?` for help.');halt end;
  239.        for i:=1 to ParamCount do
  240.            begin
  241.            Param:=ParamStr(i);
  242.            If Param[1]='-' then
  243.               if Length(Param)=1 then begin Writeln('parse: bad parameter ',Param);halt(1) end
  244.               else
  245.                   Case UpCase(Param[2]) of
  246.                        '?': Help;
  247.                        'B': Flags.Backup:=True;
  248.                        'D': Flags.Debug:=True;
  249.                        'F': Flags.Force:=True;
  250.                        'I': Flags.Interact:=True;
  251.                        'J': Flags.JustName:=True;
  252.                        'O': Flags.Override:=True;
  253.                        'Q': Flags.Query:=True;
  254.                        'V': Flags.Verbose:=True;
  255.                        'X': Include:=not Include;
  256.                        'L': if TempMode=None then TempMode:=List
  257.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  258.                        'E': if TempMode=None then TempMode:=Extract
  259.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  260.                        'A': if TempMode=None then TempMode:=Add
  261.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  262.                        'R': if TempMode=None then TempMode:=Remove
  263.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  264.                        'N': if TempMode=None then TempMode:=Rename
  265.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  266.                        else begin writeln('parse: unknown parameter ',Param);halt(1) end;
  267.                   end
  268.            else if Param[1]='@' then
  269.                    if Length(Param)=1 then begin Writeln('parse: no file specified ',Param);halt(1) end
  270.                    else
  271.                        FromFile(Param,Include,TempSpec)
  272.            else
  273.                if Length(MainPAK)=0 then
  274.                   MainPAK:=MakePakFilename(Param)
  275.                else
  276.                    AddFilespec(Param,Include,TempSpec);
  277.            end;
  278.        if TempMode=None then begin writeln('parse: no operating mode specified'); halt(1) end;
  279.        if MainPAK =''   then begin writeln('parse: no .PAK file specified'); halt(1) end;
  280.        {
  281.        if (not exist('QUAKE.EXE')) and (not Flags.Override) then begin
  282.           writeln('safety: You must run xpak in the same directory as QUAKE.EXE'); halt(3) end;
  283.        }  {old qtest thing}
  284.        CheckParams:=TempMode;
  285.        end;
  286.  
  287. function StripPath(bigstr: string):string;
  288.   var
  289.     i: integer;
  290.     last: integer;
  291.   begin
  292.     if Length(bigstr)=0 then begin StripPath:='';exit end;
  293.     last:=0;
  294.     for i:=1 to Length(bigstr) do
  295.       if (bigstr[i]='\') or (bigstr[i]='/') then last:=i;
  296.  
  297.     StripPath:=Copy(bigstr,i+1,255);
  298.   end;
  299.  
  300. function Match(TestStr:string; SpecList: PFileSpecList):boolean;
  301.   var
  302.      Matched: boolean;
  303.      ListTemp: PFileSpecList;
  304.   begin
  305.        cvForeslash(testStr);Lower4(TestStr);
  306.        ListTemp:=SpecList^.Next;
  307.        if ListTemp=nil then Match:=True else Match:=False;
  308.        while ListTemp<>nil do
  309.              begin
  310.              if WildCardMatch(StripPath(ListTemp^.Lumpname),TestStr) then
  311.                 Match:=ListTemp^.Included;
  312.              if WildCardMatch(ListTemp^.Lumpname,TestStr) then{in wildmat.tpu}
  313.                 Match:=ListTemp^.Included;
  314.              ListTemp:=ListTemp^.Next;
  315.              end;
  316.   end;
  317.  
  318.  
  319. function GetEntry(srch:string;ListTemp:PMasterDir):PMasterDir;
  320.   var
  321.      fn:string;
  322.   begin
  323.        GetEntry:=nil;
  324.        cvForeslash(srch);Lower4(srch);
  325.        while ListTemp<>nil do
  326.              begin
  327.              SetStr(fn,ListTemp^.Dir.Lumpname);
  328.              if srch=fn then
  329.                 begin
  330.                 GetEntry:=ListTemp;
  331.                 exit;
  332.                 end;
  333.              ListTemp:=ListTemp^.Next;
  334.              end;
  335.   end;
  336.  
  337.  
  338. function OpenPak(var Handle: file; filename: string):boolean;
  339.   var
  340.      IdStr: string[4];
  341.      check: word;
  342.   begin
  343.        Assign(Handle,filename);
  344.        OpenPAK:=False;
  345.  
  346.        {$I-}
  347.        Reset(Handle,1);
  348.        case IOResult of
  349.             0:;
  350.             2:begin writeln('open: file not found'); exit end;
  351.             3:begin writeln('open: path not found'); exit end;
  352.             5:begin writeln('open: access denied'); exit end;
  353.             else begin writeln('open: error accessing file'); exit end;
  354.        end;
  355.        {$I+}
  356.  
  357.        IdStr[0]:=#4;
  358.        BlockRead(Handle,IdStr[1],4,check);
  359.        if check<>4 then begin writeln('open/idstr: read size mismatch.  requested 4, received ',check);OpenPAK:=False end;
  360.        if IdStr<>PAK_HEADER then begin writeln('open: not a valid PAK file.'); exit end;
  361.        OpenPAK:=True;
  362.   end;
  363.  
  364.  
  365. procedure WriteHeader(var pak:file);
  366.   const
  367.        Header:array[1..12] of char=PAK_HEADER+#12#0#0#0#0#0#0#0;
  368.   begin
  369.        if Flags.Verbose then writeln('writehdr: writing PAK header');
  370.        BlockWrite(pak,Header,12);
  371.   end;
  372.  
  373.  
  374. function ReadDirectory(var pak: file): PMasterDir;
  375.   var
  376.      check: word;
  377.      TempDir: DirEntry;
  378.      LumpNum: word;
  379.      ListTemp: PMasterDir;
  380.      ListStart: PmasterDir;
  381.      filename: string;
  382.  
  383.   begin
  384.        readDirectory:=nil;
  385.        New(ListStart);ListTemp:=ListStart;
  386.        BlockRead(pak,TempDir.Pos,4,check);
  387.        if check<>4 then begin writeln('readdir/dirpos: read size mismatch.  requested 4, received ',check);exit end;
  388.        BlockRead(pak,TempDir.Size,4,check);
  389.        if check<>4 then begin writeln('readdir/dirsize: read size mismatch.  requested 4, received ',check);exit end;
  390.        if TempDir.Size=0 then exit;
  391.  
  392.        if Flags.Verbose then writeln('readdir: reading PAK directory');
  393.        Seek(pak,TempDir.Pos);
  394.        for LumpNum:=1 to TempDir.Size div SizeOf(DirEntry) do
  395.            begin
  396.            BlockRead(pak,TempDir,SizeOf(DirEntry),check);
  397.            if check<>SizeOf(DirEntry) then
  398.               begin writeln('readdir/entries: read size mismatch.  requested ',SizeOf(DirEntry),' received ',check);exit end;
  399.            SetStr(filename,TempDir.Lumpname);
  400.            cvBackslash(filename);
  401.            New(ListTemp^.Next);
  402.            ListTemp^.Next^.Prev:=ListTemp;
  403.            ListTemp^.Next^.Next:=nil;
  404.            ListTemp:=ListTemp^.Next;
  405.            ListTemp^.Dir:=TempDir;
  406.            ListTemp^.Filename:=filename;
  407.            end;
  408.        ListTemp:=ListStart^.Next;
  409.        ListTemp^.Prev:=nil;
  410.        Dispose(ListStart);
  411.        ReadDirectory:=ListTemp;
  412.   end;
  413.  
  414.  
  415. function CreateDirectory(Files:PFileSpecList):PMasterDir;
  416.   var
  417.      MstrTemp: PMasterDir;
  418.      MstrStart: PMasterDir;
  419.      MstrMatch: PMAsterDir;
  420.      SpecTemp: PFileSpecList;
  421.      TempStr,TempFile: string;
  422.      DirInfo: SearchRec;
  423.      p:DirStr; f:NameStr; e:ExtStr;
  424.   begin
  425.        New(MstrStart);MstrTemp:=MstrStart;MstrTemp^.Next:=nil;
  426.        SpecTemp:=Files^.Next;
  427.        while SpecTemp<>nil do
  428.              begin
  429.              TempStr:=SpecTemp^.Filespec;
  430.              cvBackslash(TempStr);
  431.              FSplit(TempStr,p,f,e);
  432.              FindFirst(Tempstr,Anyfile-Directory-Hidden-VolumeID,DirInfo);
  433.              while DosError=0 do
  434.                    begin
  435.                    TempFile:=p+DirInfo.Name;
  436.                    cvForeSlash(TempFile);Lower4(TempFile);
  437.                    MstrMatch:=nil;
  438.                    if SpecTemp^.Remapped then
  439.                       begin
  440.                       MstrMatch:=GetEntry(SpecTemp^.Lumpname,MstrStart);
  441.                       if MstrMatch<>nil then
  442.                          begin
  443.                          MstrMatch^.Filename:=p+DirInfo.Name;
  444.                          MstrTemp^.Dir.Size:=DirInfo.Size;
  445.                          end;
  446.                       TempFile:=SpecTemp^.Lumpname;
  447.                       end;
  448.                    if MstrMatch=nil then
  449.                       begin
  450.                       New(MstrTemp^.Next);
  451.                       MstrTemp^.Next^.Prev:=MstrTemp;
  452.                       MstrTemp:=MstrTemp^.Next;
  453.                       MstrTemp^.Next:=nil;
  454.                       MstrTemp^.Filename:=p+DirInfo.name;
  455.                       SetArr(MstrTemp^.Dir.Lumpname,Tempfile);
  456.                       MstrTemp^.Dir.Size:=DirInfo.Size;
  457.                       MstrTemp^.Dir.Pos:=0;
  458.                       end;
  459.                    FindNext(DirInfo);
  460.                    end;
  461.              SpecTemp:=SpecTemp^.Next;
  462.        end;
  463.        MstrTemp:=MstrStart^.Next;
  464.        MstrTemp^.Prev:=nil;
  465.        Dispose(MstrStart);
  466.        CreateDirectory:=MstrTemp;
  467.   end;
  468.  
  469.  
  470. function WriteDirectory(var pak:file;ListTemp:PMasterDir): boolean;
  471.   var
  472.      DirPos,DirLen: Longint;
  473.      check:word;
  474.   begin
  475.        WriteDirectory:=False;
  476.        seek(pak,FileSize(pak));
  477.        DirPos:=FilePos(pak);
  478.        if Flags.Verbose then writeln('writedir: writing new PAK directory');
  479.        DirLen:=0;
  480.        while ListTemp<>nil do
  481.              begin
  482.              BlockWrite(pak,ListTemp^.Dir,Sizeof(DirEntry),check);
  483.              if check<SizeOf(DirEntry) then begin
  484.                 writeln('writedir: write size mismatch.  requested ',SizeOf(DirEntry),' wrote ',check,'. out of disk space?');
  485.                 close(pak); exit end;
  486.              Inc(DirLen,SizeOf(DirEntry));
  487.              ListTemp:=ListTemp^.Next;
  488.              end;
  489.        Seek(pak,4);
  490.        BlockWrite(pak,DirPos,4);
  491.        BlockWrite(pak,DirLen,4);
  492.        WriteDirectory:=True;
  493.   end;
  494.  
  495.  
  496. procedure CropDirectory(var pak:file);
  497.   var
  498.      DirPos,DirLen:LongInt;
  499.   begin
  500.        Reset(pak,1);
  501.        Seek(pak,4);
  502.        BlockRead(pak,DirPos,4);
  503.        BlockRead(pak,DirLen,4);
  504.        Seek(pak,DirPos);
  505.        Truncate(pak);Close(pak);Reset(pak,1);
  506.   end;
  507.  
  508.  
  509. procedure RemapFilenames(MstrList:PMasterDir; Filespec:PFilespecList);
  510.   var
  511.      SpecTemp: PFileSPecList;
  512.      lumpname: string;
  513.   begin
  514.        while MstrList<>nil do
  515.              begin
  516.              SetStr(lumpname,MstrList^.Dir.Lumpname);
  517.              SpecTemp:=FileSpec;
  518.              while SpecTemp<>nil do
  519.                    begin
  520.                    if SpecTemp^.Remapped then
  521.                       if lumpname=SpecTemp^.Lumpname then
  522.                          MstrList^.Filename:=SpecTemp^.filespec;
  523.                    SpecTemp:=SpecTemp^.Next;
  524.                    end;
  525.              MstrList:=MstrList^.Next;
  526.              end;
  527.   end;
  528.  
  529.  
  530. procedure MakePath(const pname: string);
  531.   var
  532.      slashpos: byte;
  533.      TempStr: string;
  534.   begin
  535.        {$I-}
  536.        for slashpos:=1 to Length(pname) do
  537.            if pname[slashpos]='\' then
  538.               begin
  539.               TempStr:=Copy(Pname,1,slashpos-1);
  540.               mkdir(TempStr);
  541.               if IOResult=0 then
  542.                  if Flags.Verbose then
  543.                     begin
  544.                     cvForeslash(tempstr);Lower4(tempstr);
  545.                     writeln('mkdir: ',TempStr);
  546.                     end;
  547.               end;
  548.        {$I+}
  549.   end;
  550.  
  551.  
  552. procedure BAKFile(Filename:string);
  553.   var
  554.      p:Dirstr;n:NameStr;e:extstr;
  555.      NewName:String;
  556.      Regs:Registers;
  557.   begin
  558.        if Flags.Verbose then writeln('backup: ',Filename);
  559.        FSplit(Filename,p,n,e);
  560.        NewName:=p+n+'.bak'+#0;
  561.        Filename:=Filename+#0;
  562.        Regs.AH := $56;
  563.        Regs.DS := Seg(FileName);
  564.        Regs.DX := Ofs(FileName) + 1;
  565.        Regs.ES := Seg(NewName);
  566.        Regs.DI := Ofs(NewName) + 1;
  567.        MsDos(Regs);
  568.   end;
  569.  
  570.  
  571. function CopyData(var src,dest: file; Amount:LongInt):boolean;
  572.   var
  573.      Buf: ^Buffer;
  574.      BlockSize:word;
  575.      check:word;
  576.   begin
  577.        CopyData:=False;
  578.        New(buf);
  579.        If Flags.Debug then writeln('copy: copying ',Amount,' bytes. srcpos=',FilePos(src),' destpos=',FilePos(dest));
  580.        While Amount>0 do
  581.              begin
  582.              if Amount>MAX_BLOCK_SIZE then
  583.                 BlockSize:=MAX_BLOCK_SIZE
  584.              else
  585.                  BlockSize:=Amount;
  586.              Dec(Amount,BlockSize);
  587.              BlockRead(src,buf^,Blocksize,check);
  588.              if check<>BlockSize then begin
  589.                 writeln('copy: read size mismatch.  requested ',BlockSize,' received ',check);
  590.                 Dispose(Buf);exit end;
  591.              BlockWrite(dest,buf^,Blocksize,check);
  592.              if check<>BlockSize then begin
  593.                 writeln('copy: write size mismatch.  requested ',Blocksize,' wrote ',check,'. out of disk space?');
  594.                 Dispose(Buf);exit end;
  595.              end;
  596.        Dispose(buf);
  597.        CopyData:=True;
  598.   end;
  599.  
  600.  
  601. function MoveData(var handle:file;fPos,Size,Offset:LongInt):boolean;
  602.   var                                 {rPos is startpos}
  603.      Buf: ^Buffer;                    {rSize is amout to move}
  604.      Blocksize:Longint;               {rOffset is amount to move by, +/-}
  605.      EndPos:Longint;
  606.      check:word;
  607.   begin
  608.        if (Size=0) or (Offset=0) then begin MoveData:=True;exit end;
  609.        MoveData:=False;
  610.        New(Buf);
  611.        If Flags.Debug then writeln('move: moving ',Size,' bytes from ',fPos,' by ',Offset,' bytes. (to ',fpos+Offset,')');
  612.        if Offset>0 then Inc(fPos,Size);
  613.        while Size>0 do
  614.              begin
  615.              if Size>MAX_BLOCK_SIZE then
  616.                 BlockSize:=MAX_BLOCK_SIZE
  617.              else
  618.                  BlockSize:=Size;
  619.              Dec(Size,BlockSize);
  620.              if OffSet>0 then
  621.                 Seek(Handle,fpos-BlockSize)
  622.              else
  623.                  Seek(handle,fPos);
  624.              BlockRead(handle,Buf^,Blocksize,check);
  625.              if check<>BlockSize then begin
  626.                 writeln('move: read size mismatch.  requested ',Blocksize,' received ',check);
  627.                 Dispose(Buf);Close(handle);exit end;
  628.              Seek(handle,Filepos(Handle)-BlockSize+Offset);
  629.              BlockWrite(handle,buf^,Blocksize,check);
  630.              if check<>BlockSize then begin
  631.                 writeln('delete: write size mismatch.  requested ',Blocksize,' wrote ',check,'. out of disk space?');
  632.                 Dispose(Buf);Close(handle); exit end;
  633.              if Offset>0 then
  634.                 Dec(fpos,BlockSize)
  635.              else
  636.                  Inc(fpos,BlockSize);
  637.              end;
  638.        Dispose(Buf);
  639.        MoveData:=True;
  640.   end;
  641.  
  642.  
  643. procedure ListLump(Entry: DirEntry);
  644.   var
  645.      TempStr: string;
  646.      DispStr: string[40];
  647.   begin
  648.        SetStr(TempStr,Entry.Lumpname);
  649.        if Flags.JustName then
  650.           Writeln(TempStr)
  651.        else
  652.            begin
  653.            FillChar(DispStr[1],40,' ');
  654.            DispStr:=TempStr;
  655.            DispStr[0]:=#40;
  656.            Write(DispStr);
  657.            Write('Pos=',Entry.Pos:8);
  658.            Writeln('  Size=',Entry.Size:8,' (bytes)');
  659.        end;
  660.   end;
  661.  
  662.  
  663. procedure ExtractLump(var pak:file;const Entry: PMasterDir);
  664.   var
  665.      lname:string;
  666.      op: file;
  667.      ky:char;
  668.      tempstr:string;
  669.  
  670.   begin
  671.        SetStr(lname,Entry^.Dir.Lumpname);
  672.        MakePath(Entry^.Filename);
  673.        tempstr:=Entry^.Filename;cvForeslash(tempstr);Lower4(tempstr);
  674.        if not Flags.Force then
  675.           if exist(Entry^.Filename) then
  676.              if Flags.Interact then
  677.                 begin
  678.                 write('extract: overwrite file ',tempstr,'? [ynasq]');
  679.                 ky:=ReadKey;
  680.                 case UpCase(ky) of
  681.                   'N':;
  682.                   'A':Flags.Force:=True;
  683.                   'S':Flags.Interact:=False;
  684.                   'Q':halt(HALT_QUIT);
  685.                   'Y':;
  686.                   else ky:='n';
  687.                   end;
  688.                 writeln(ky);
  689.                 if UpCase(ky)='N' then exit;
  690.                 end
  691.              else
  692.                  begin
  693.                  writeln ('extract: ',tempstr,' exists.  skipping');
  694.                  exit
  695.                  end;
  696.        if Flags.BAckup then
  697.           if Exist(Entry^.Filename) then
  698.              BAKFile(Entry^.Filename);
  699.        if Flags.Verbose then
  700.           if tempstr=lname then
  701.              writeln('extract: ',lname)
  702.           else
  703.               writeln('extract: ',lname,' from file ',tempstr);
  704.        Assign(op,Entry^.Filename);
  705.        Rewrite(op,1);
  706.        if IOResult<>0 then begin writeln('extract: unable to open ',tempstr); exit end;
  707.  
  708.        Seek(pak,Entry^.Dir.Pos);
  709.        CopyData(pak,op,Entry^.Dir.Size);
  710.        Close(op);
  711.   end;
  712.  
  713.  
  714. function AddLump(var Handle: file; Filename: string):Longint;
  715.   var
  716.      ip: file;
  717.      buf: ^Buffer;
  718.      BlockSize: word;
  719.      check: word;
  720.  
  721.   begin
  722.        AddLump:=0;
  723.        New(buf);
  724.        Assign(ip,Filename);
  725.        ReSet(ip,1);
  726.        AddLump:=FileSize(Handle);
  727.        Seek(Handle,FileSize(Handle));
  728.        while not eof(ip) do
  729.              begin
  730.              BlockRead(ip,buf^,MAX_BLOCK_SIZE,BlockSize);
  731.              BlockWrite(Handle,buf^,BlockSize,check);
  732.              if check<BlockSize then begin
  733.                 writeln('addlump: write size mismatch.  Requested ',SizeOf(DirEntry),' wrote ',check,'. out of disk space?');
  734.                 Dispose(Buf);Close(Handle);close(ip);AddLump:=0; exit end;
  735.              end;
  736.        Dispose(buf);
  737.        Close(ip);
  738.   end;
  739.  
  740.  
  741. function UpdateLump(var pak:file;Entry:PMasterDir;ListTemp:PMasterDir):boolean;
  742.   var
  743.      lumpname,tempstr: string;
  744.      ip: file;
  745.   begin
  746.        UpdateLump:=False;
  747.        SetStr(Lumpname,Entry^.Dir.Lumpname);
  748.        if Flags.Verbose then
  749.           begin
  750.           tempstr:=Entry^.filename;cvForeslash(Tempstr);Lower4(tempstr);
  751.           writeln('update: ',lumpname,' with file ',tempstr);
  752.           end;
  753.  
  754.        Assign(ip,Entry^.Filename);
  755.        ReSet(ip,1);
  756.        if not MoveData(pak,Entry^.Dir.Pos+Entry^.Dir.Size,
  757.                            FileSize(pak)-Entry^.Dir.Pos-Entry^.Dir.Size,
  758.                            FileSize(ip)-Entry^.Dir.Size) then begin
  759.           writeln('update: error moving data in PAK file.');Close(ip);exit end;
  760.        Seek(pak,Entry^.Dir.Pos);
  761.        if not CopyData(ip,pak,FileSize(ip)) then begin
  762.           writeln('update: error reading from file.');close(ip);exit end;
  763.        if FileSize(ip) < Entry^.Dir.Size then
  764.           begin
  765.           Seek(pak,FileSize(pak)+FileSize(ip)-Entry^.Dir.Size);
  766.           Truncate(pak);Close(pak);Reset(pak,1);
  767.           end;
  768.        While ListTemp<>nil do
  769.              begin
  770.              if ListTemp^.Dir.Pos>Entry^.Dir.Pos then
  771.                 if ListTemp^.Dir.Pos<>0 then
  772.                    Inc(ListTemp^.Dir.Pos,FileSize(ip)-Entry^.Dir.Size)
  773.                 else
  774.              else if ListTemp^.Dir.Pos=Entry^.Dir.Pos then
  775.                   ListTemp^.Dir.Size:=FileSize(ip);  {Original record}
  776.              ListTemp:=ListTemp^.Next;
  777.              end;
  778.        Close(ip);
  779.        UpdateLump:=true;
  780.   end;
  781.  
  782.  
  783. procedure RemoveLump(var pak:file;Lump: PMasterDir; var MasterDir:PMasterDir);
  784.   var
  785.      ListTemp : PMasterDir;
  786.   begin
  787.        if Lump=nil then exit;
  788.        if Lump^.Prev=nil then
  789.           begin
  790.           Lump:=MasterDir;
  791.           MasterDir:=Lump^.Next;
  792.           MasterDir^.Prev:=nil
  793.           end
  794.        else
  795.            begin
  796.            Lump^.Prev^.Next:=Lump^.Next;
  797.            if Lump^.Next<>nil then Lump^.Next^.Prev:=Lump^.Prev;
  798.            end;
  799.  
  800.        if not MoveData(pak,Lump^.Dir.Pos+Lump^.Dir.Size,
  801.                            FileSize(pak)-Lump^.Dir.Pos-Lump^.Dir.Size,
  802.                            -Lump^.Dir.Size)
  803.           then begin writeln('remove: error moving data in PAK file.'); exit end;
  804.        Seek(pak,FileSize(pak)-Lump^.Dir.Size);
  805.        Truncate(pak);Close(pak);Reset(pak,1);
  806.  
  807.        ListTemp:=MasterDir;
  808.        while ListTemp<>nil do
  809.              begin
  810.              if ListTemp^.Dir.Pos>Lump^.Dir.Pos then
  811.                 Dec(ListTemp^.Dir.Pos,Lump^.Dir.Size);
  812.              ListTemp:=ListTemp^.Next;
  813.              end;
  814.        Dispose(Lump);
  815.   end;
  816.  
  817.  
  818. procedure SafetyPAK(pakfile:string);
  819.   var
  820.      pakname: string;
  821.   begin
  822.        if not Flags.OverRide then
  823.           begin
  824.           lower4(pakfile);
  825.           pakname:=StripPath(pakfile);
  826.           if pakname='pak0.pak' then
  827.              begin writeln('safety: will not write to PAK0.PAK'); halt(HALT_SAFETY) end;
  828.           if pakname='pak1.pak' then
  829.              begin writeln('safety: will not write to PAK1.PAK'); halt(HALT_SAFETY) end;
  830.  
  831.           end;
  832.   end;
  833.  
  834.  
  835. procedure ListPAK(pakfile:string;filespec:PFilespecList);
  836.   var
  837.      ListTemp:PMasterDir;
  838.      pak: file;
  839.      lumpname: string;
  840.   begin
  841.        if not OpenPAK(pak,pakfile) then exit;
  842.        ListTemp:=ReadDirectory(pak);
  843.        Close(pak);
  844.        while ListTemp<>nil do
  845.              begin
  846.              SetStr(lumpname,ListTemp^.Dir.Lumpname);
  847.              if Match(lumpname,FileSpec) then
  848.                 ListLump(ListTemp^.Dir);
  849.              ListTemp:=ListTemp^.Next;
  850.              end;
  851.  
  852.   end;
  853.  
  854.  
  855. procedure ExtractPAK(pakfile:string;filespec:PFilespecList);
  856.   var
  857.      ListTemp: PMasterDir;
  858.      pak:file;
  859.      lumpname: string;
  860.   begin
  861.        if not OpenPAK(pak,pakfile) then exit;
  862.        ListTemp:=ReadDirectory(pak);
  863.        RemapFilenames(ListTemp,filespec);
  864.        while ListTemp<>nil do
  865.              begin
  866.              SetStr(lumpname,ListTemp^.Dir.Lumpname);
  867.              if Match(lumpname,filespec) then
  868.                 ExtractLump(pak,ListTemp);
  869.              ListTemp:=ListTemp^.Next;
  870.              end;
  871.   end;
  872.  
  873.  
  874. procedure AddPAK(pakfile:string;filespec:PFilespecList);
  875.   var
  876.      ListPrev,ListTemp,OldEntry:PMasterDir;
  877.      pak:file;
  878.      MstrStart: PMasterDir;
  879.      NewStart: PMAsterDir;
  880.      srcfile,srclump:string;
  881.      tempstr:string;
  882.      ky: char;
  883.      SkipUpdate: boolean;
  884.   begin
  885.        SafetyPAK(pakfile);
  886.        SkipUpdate:=False;
  887.  
  888.        if not exist(pakfile) then
  889.           begin
  890.           Assign(pak,pakfile);ReWrite(pak,1);
  891.           WriteHeader(pak);Close(pak);
  892.           end;
  893.        if not OpenPAK(pak,pakfile) then exit;
  894.  
  895.        NewStart:=CreateDirectory(filespec);     {Get New lumps}
  896.        MstrStart:=ReadDirectory(pak);           {Get original directory}
  897.        ListPrev:=MstrStart;
  898.        if ListPrev<>nil then
  899.           begin
  900.           while ListPrev^.Next<>nil do
  901.                 ListPrev:=ListPrev^.Next;
  902.           ListPrev^.Next:=NewStart;
  903.           NewStart^.Prev:=ListPrev; {Paste New lumps onto end of original}
  904.           end
  905.        else
  906.            begin
  907.            MstrStart:=NewStart;
  908.            NewStart^.Prev:=nil;
  909.            end;
  910.  
  911.        CropDirectory(pak);
  912.  
  913.        ListTemp:=NewStart;
  914.        while ListTemp<>nil do
  915.              begin
  916.              srcfile:=ListTemp^.Filename;
  917.              SetStr(srclump,ListTemp^.Dir.Lumpname);
  918.              OldEntry:=GetEntry(srclump,MstrStart);
  919.              if OldEntry = ListTemp then
  920.                 begin
  921.                 if Flags.Verbose then
  922.                    begin
  923.                    tempstr:=srcfile;cvForeslash(tempstr);Lower4(tempstr);
  924.                    if tempstr=srclump then
  925.                       writeln('add: ',srclump)
  926.                    else
  927.                        writeln('add: ',srclump,' from file ',tempstr);
  928.                    end;
  929.                 ListTemp^.Dir.Pos:=AddLump(pak,srcfile);
  930.                 if ListTemp^.Dir.Pos=0 then
  931.                    begin
  932.                         ListPrev^.Next:=ListTemp^.Next;
  933.                         if ListTemp^.Next<>nil then
  934.                            ListTemp^.Next^.Prev:=ListPrev;
  935.                         ListTemp:=ListTemp^.Next;
  936.                    end
  937.                 else
  938.                     begin
  939.                     Listprev:=ListTemp;
  940.                     ListTemp:=ListTemp^.Next;
  941.                     end
  942.                 end
  943.              else
  944.                  begin
  945.                  ky:='Y';
  946.                  if SkipUpdate then
  947.                     begin
  948.                     ky:='N';
  949.                     if Flags.Verbose then writeln('update: skipping ',srclump);
  950.                     end;
  951.                  if Flags.Interact then
  952.                     begin
  953.                     write('update: update lump ',srclump,'? [ynasq]');
  954.                     ky:=ReadKey;
  955.                     case UpCase(ky) of
  956.                       'A':Flags.Interact:=False;
  957.                       'S':begin SkipUpdate:=True; if Flags.Verbose then writeln('update: skipping ',srclump);end;
  958.                       'Q':halt(HALT_QUIT);
  959.                       'Y':;
  960.                       else ky:='n';
  961.                       end;
  962.                     writeln(ky);
  963.                     end;
  964.                  ListTemp^.Dir:=OldEntry^.Dir;
  965.                  if (UpCase(ky)='Y') or (UpCase(ky)='A') then
  966.                     if UpdateLump(pak,ListTemp,MstrStart) then
  967.                        begin
  968.                        ListPrev^.Next:=ListTemp^.Next;
  969.                        Dispose(ListTemp);
  970.                        ListTemp:=ListPrev^.Next;
  971.                        if ListTemp<>nil then ListTemp^.Prev:=ListPrev;
  972.                        end;
  973.                  end;
  974.              end;
  975.  
  976.        WriteDirectory(pak,MstrStart);
  977.        Close(pak);
  978.   end;
  979.  
  980.  
  981. procedure RemovePAK(pakfile:string;filespec:PFilespecList);
  982.   var
  983.      pak:file;
  984.      ListTemp:PMasterDir;
  985.      MstrStart :PMasterDir;
  986.      DirLen,DirPos: Longint;
  987.      lumpname: string;
  988.   begin
  989.        SafetyPAK(pakfile);
  990.        if not OpenPAK(pak,pakfile) then exit;
  991.        MstrStart:=ReadDirectory(pak);
  992.        if Filespec=nil then writeln('remove: no entries to process');
  993.  
  994.        CropDirectory(pak);
  995.  
  996.        ListTemp:=MstrStart;
  997.        while ListTemp<>nil do
  998.              begin
  999.              SetStr(lumpname,ListTemp^.Dir.Lumpname);
  1000.              if Match(lumpname,Filespec) then
  1001.                 begin
  1002.                 if Flags.Verbose then writeln('remove: ',lumpname);
  1003.                 RemoveLump(pak,ListTemp,MstrStart);
  1004.                 end;
  1005.              ListTemp:=ListTemp^.Next;
  1006.              end;
  1007.        WriteDirectory(pak,MstrStart);
  1008.        Close(pak);
  1009.   end;
  1010.  
  1011.  
  1012. procedure RenamePAK(pakfile:string;filespec:PFilespecList);
  1013.   var
  1014.      MstrStart: PMasterDir;
  1015.      MstrTemp:PMasterDir;
  1016.      SpecTemp: PFileSPecList;
  1017.      lumpname,newname: string;
  1018.      pak: file;
  1019.   begin
  1020.        SafetyPAK(pakfile);
  1021.        if not OpenPAK(pak,pakfile) then exit;
  1022.        MstrStart:=ReadDirectory(pak);
  1023.        MstrTemp:=MstrStart;
  1024.        while MstrTemp<>nil do
  1025.              begin
  1026.              SetStr(lumpname,MstrTemp^.Dir.Lumpname);
  1027.              SpecTemp:=FileSpec;
  1028.              while SpecTemp<>nil do
  1029.                    begin
  1030.                    if SpecTemp^.Remapped then
  1031.                       if lumpname=SpecTemp^.Lumpname then
  1032.                          begin
  1033.                          newname:=SpecTemp^.Filespec;
  1034.                          cvForeslash(newname);Lower4(newname);
  1035.                          SetArr(MstrTemp^.Dir.Lumpname,newname);
  1036.                          if Flags.Verbose then
  1037.                             writeln('rename: ',lumpname,' to ',newname);
  1038.                          end;
  1039.                    SpecTemp:=SpecTemp^.Next;
  1040.                    end;
  1041.              MstrTemp:=MstrTemp^.Next;
  1042.              end;
  1043.        CropDirectory(pak);
  1044.        WriteDirectory(pak,MstrStart);
  1045.        Close(pak);
  1046.   end;
  1047.  
  1048.  
  1049. var
  1050.    pakfile:string;
  1051.    filespec:PFileSpecList;
  1052.  
  1053. begin
  1054.      DirectVideo:=False;
  1055.      Assign(Output,'');ReWrite(Output);
  1056.      Writeln('# XPak v0.4.1; 96/09/30. (c) Tom Wheeley; <splitbung>, tomw@tsys.demon.co.uk; '#13#10);
  1057.      Case CheckParams(pakfile,filespec) of
  1058.           List:    ListPAK(pakfile,filespec);
  1059.           Extract: ExtractPAK(pakfile,filespec);
  1060.           Add:     AddPAK(pakfile,filespec);
  1061.           Remove:  RemovePAK(pakfile,filespec);
  1062.           Rename:  RenamePAK(pakfile,filespec);
  1063.           else writeln('main: mode not yet implemented');
  1064.      end;
  1065. end.